home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.05 May 88 / forth source / TEStylDemo < prev   
Encoding:
Text File  |  1988-03-06  |  17.7 KB  |  705 lines  |  [TEXT/MACH]
  1. \ New Text Edit example
  2. \ J. Langowski for Mac Tutor March 1988
  3. \ derived from
  4. \ Editor Shell Example Program on Mach 2 demo disk
  5.  
  6. \ found two 'features' of the new text edit while experimenting:
  7. \ a. when the insertion point is at a boundary between
  8. \    two different styles, the text typed will be TEKeyed 
  9. \    according to the style BEFORE the insertion point, while
  10. \    TEGetStyle will return style information from AFTER the
  11. \    insertion point.
  12. \ b. Although the text face seems to be set inside the style record
  13. \    and properly associated with the text (TEGetStyle returns the correct
  14. \    information after the text face has been changed), the text is
  15. \    always drawn plain text style. The font and size changes work OK.
  16. \
  17.  
  18. only forth definitions
  19. also assembler also mac
  20.  
  21. \ ***** constants
  22.  
  23. 300 CONSTANT APPLEID \ menu IDs for the menus to be set up
  24. 310 CONSTANT FILEID
  25. 320 CONSTANT EDITID
  26. 330 CONSTANT SIZEID
  27. 340 CONSTANT FontID
  28. 350 CONSTANT StyleID
  29.  
  30. 20  CONSTANT InUpArrow     \ part code for up arrow of scrollbar
  31. 21  CONSTANT InDownArrow \ part code for down arrow of scrollbar
  32. 22  CONSTANT InPageUp     \ part code for page up region of scrollbar
  33. 23  CONSTANT InPageDown     \ part code for page down region of scrollbar
  34. 129 CONSTANT InThumb     \ part code for thumb of scrollbar
  35.  
  36. $44525652 Constant "drvr
  37. $464F4E54 Constant "font
  38.  
  39. %000001000000000 CONSTANT ShiftMask \ Mask used to isolate shift bit
  40.                     \ in modifiers word of event record
  41.  
  42. $10 CONSTANT    portRect \ Grafport rectangle
  43. $6E CONSTANT    wVisible \ visible flag [byte]
  44.  
  45. \ text edit equates
  46. 0  CONSTANT    teDestRect    ( destination rectangle  [8 bytes] )
  47. 8  CONSTANT    teViewRect    ( view rectangle rectangle [8 bytes] )
  48. $C  CONSTANT    selRect        ( select rectangle [8 bytes] )
  49. $18 CONSTANT    teLineHite    ( line height [word] )
  50. $1A CONSTANT    teFontAscent    \ font ascent [word]
  51. $1C CONSTANT    teSelPoint    \ selection point [long word]
  52. $20 CONSTANT    teSelStart    ( selection start [word] )
  53. $22 CONSTANT    teSelEnd    ( selection end [word] )
  54. $38 CONSTANT    teCarOn        ( is caret on? [byte] )
  55. $39 CONSTANT    teCarAct    ( is caret active? [byte] )
  56. $3C CONSTANT    teLength    ( length of text below [word] )
  57. $3E CONSTANT    teTextH        ( text [handle] )
  58. $48 CONSTANT    teCROnly    ( <CR> only for line breaks? [byte] )
  59. $4A CONSTANT    teFont        ( text font [word] )
  60. $4C CONSTANT    teFace        ( text face [word] )
  61. $4A CONSTANT    teStylHandle    \ handle to style record for new
  62.                 \ text edit. Never accessed directly
  63. $4E CONSTANT    teMode        \ text mode [word] 
  64. $50 CONSTANT    teSize    \ font size [word] for old style record.
  65.             \ for a new style record, this contains -1.
  66.             \ in that case, teFont and teFace together contain
  67.             \ the handle to the style record.
  68. $5E CONSTANT    teNLines    ( number of lines [word] )
  69. $60 CONSTANT    teLines        ( lines starts [word] )
  70.                 
  71.                 ( TextEdit Globals )
  72. $AB0 CONSTANT    TEScrpLength    ( textEdit Scrap Length [word] )
  73. $AB4 CONSTANT    TEScrpHandle    ( textEdit Scrap [handle] )
  74. $AF6 CONSTANT    TEWdBreak    ( default word break routine [pointer] )
  75.  
  76. \ Event Record Equates
  77. $0 CONSTANT    What        ( event code [word] )
  78. $2 CONSTANT    Message        ( event message [long] )    
  79. $6 CONSTANT    When        ( ticks since start-up  [long] )
  80. $A CONSTANT    Where        ( mouse loc. pt. in global coords [long] )
  81. $E CONSTANT    Modifiers    ( modifier flags  [word] )
  82.  
  83. $0A CONSTANT LF        ( ascii 'linefeed' )
  84. $20 CONSTANT SP        ( ascii 'space' )
  85.  
  86. create applestring 01 C, $14 C, \ Apple symbol
  87.  
  88. \ ***** variables
  89.  
  90. VARIABLE TEHandle        ( handle for text edit record )
  91. VARIABLE TERect     4 VALLOT    ( Text Edit view rectangle )
  92. VARIABLE SIZE            ( item# of current textsize )
  93. VARIABLE DESKNAME 252 VALLOT    \ holds name of desk accessory
  94. VARIABLE FONTNAME 252 VALLOT    \ holds font name selected
  95. VARIABLE ITEMNAME 60 VALLOT    \ receives menu item name
  96. VARIABLE MyStyle 8 VALLOT    \ text style record for our private use
  97.     \ fields of MyStyle:
  98.         0 CONSTANT tsFont
  99.         2 CONSTANT tsFace
  100.         4 CONSTANT tsSize
  101.         6 CONSTANT RGBColor
  102. VARIABLE currentFont    \ font menu ID currently checked
  103. VARIABLE #fonts        \ # of currently installed fonts
  104. VARIABLE currentSize    \ size menu ID currently checked
  105.  
  106. 76  USER AbortHook
  107. 152 USER ContentHook
  108. 160 USER GrowHook
  109. 164 USER CloseBoxHook
  110. 168 USER UpdateHook
  111. 172 USER ActivateHook
  112. 202 USER CAction    \ holds address of control action routine
  113.  
  114. \ ***** glue routines for new text edit
  115. \
  116. \ TEStylNew ( destRect viewRect -- TEHandle )
  117. \ is misspelled 'TEStyleNew' in the Mach2 trap definitions,
  118. \ but implemented. So are TEGetOffset and most of the other 
  119. \ new text edit routines that are called through TEDispatch.
  120. \ One exception is TEStylInsert, which we are defining here:
  121.  
  122. CODE TEStylInsert ( text length hST hTE -- )
  123.     EXG D4,A7
  124.     MOVE.L    $C(A6),-(A7)    \ pointer to text
  125.     MOVE.L    $8(A6),-(A7)    \ length of text
  126.     MOVE.L    $4(A6),-(A7)    \ style record handle
  127.     MOVE.L    (A6),-(A7)    \ TE record handle
  128.     ADDA.W    #$10,A6
  129.     MOVE.W    #$7,-(A7)
  130.     _TEDispatch
  131.     EXG    D4,A7
  132.     RTS
  133. END-CODE
  134.  
  135.  
  136. NEW.WINDOW Editor
  137. " Editor" Editor TITLE
  138. 42 4 330 507 Editor BOUNDS
  139. DOCUMENT INVISIBLE CLOSEBOX GROWBOX Editor ITEMS
  140.  
  141. 200 1000 TERMINAL EditTask
  142.  
  143. NEW.MBAR EditBar 
  144.  
  145. NEW.MENU AppleMenu
  146. APPLESTRING AppleMenu TITLE
  147. 0 APPLEID AppleMenu BOUNDS
  148. " About Editor ...;(-" AppleMenu ITEMS
  149.  
  150. NEW.MENU FileMenu
  151. " File" FileMenu TITLE
  152. 0 FileID FileMenu BOUNDS
  153. " New/N;Open.../O;Close;Save;Save as...;Revert to Original;(Print"
  154.                             FileMenu ITEMS
  155.  
  156. NEW.MENU EditMenu
  157. " Edit" EditMenu TITLE
  158. 0 EDITID EditMenu BOUNDS
  159. " (Undo/Z;(-;Cut/K;Copy/C;Paste/V;Clear" EditMenu ITEMS
  160.  
  161. NEW.MENU FontMenu
  162. " Font" FontMenu TITLE
  163. 0 FontID FontMenu BOUNDS
  164. "  (Fonts<I; (-" FontMenu ITEMS
  165.  
  166. NEW.MENU SizeMenu
  167. " Size" SizeMenu TITLE
  168. 0 SizeID SizeMenu BOUNDS
  169. "  9 Point; 10 Point; 12 Point; 14 Point; 18 Point; 20 Point; 24 Point" 
  170.         SizeMenu ITEMS
  171.  
  172. CREATE SizeIDTable
  173. 0 , 0 , 0 c, \ no menu IDs for sizes 0 thru 8
  174. 1 c, 2 c, 0 c, 3 c, \  9,10,--,12
  175. 0 c, 4 c, 0 c, 0 c, \ --,14,--,--
  176. 0 c, 5 c, 0 c, 6 c, \ --,18,--,20
  177. 0 c, 0 c, 0 c, 7 c, \ --,--,--,24
  178.  
  179. CREATE SizeTable
  180. 0 c, 9 c, 10 c, 12 c, 14 c, 18 c, 20 c, 24 c,
  181.  
  182.  
  183. NEW.MENU StyleMenu
  184. " Style" StyleMenu TITLE
  185. 0 StyleID StyleMenu BOUNDS
  186. "  Plain/P; Bold/B<B; Italic/I<I; Underline/U<U; Outline<O; Shadow<S; Condense; Extend" 
  187.         StyleMenu ITEMS
  188.  
  189. NEW.CONTROL Scroll                
  190. VSCROLLBAR VISIBLE 100 0 Scroll ITEMS
  191. VARIABLE lastVs
  192.  
  193. NEW.CONTROL hScroll                
  194. HSCROLLBAR VISIBLE 100 0 hScroll ITEMS
  195. VARIABLE lastHs
  196.  
  197. : CHECK  ( menuhandle item# flag -- )    ( checking a menu item )
  198.     CALL CheckItem ;
  199.     
  200. : =string { aStr bStr | -- flag }
  201.     aStr count 65536 * bStr count rot + swap
  202.     call CmpString 0=
  203. ;
  204.  
  205. CODE @TEHandle    ( -- handle )        ( an assembly language method of )
  206.     MOVE.L    TEHandle,-(A6)        ( accessing a variable's contents )
  207.     RTS
  208. END-CODE
  209.  
  210. : Shift?   (   -  f )     \ checks the event record to see if the
  211.             \ shift key was pressed. 
  212.     EVENT-RECORD Modifiers + W@    ( get modifiers word )
  213.     ShiftMask AND            ( isolate shiftbit )
  214.     IF -1 ELSE 0 THEN  
  215. ;
  216.     
  217. : LineHeight    (   -   lineheight  )    ( looks in the textedit record to )
  218.     @TEHandle @ teLineHite + W@  ;    ( see how tall each line is )    
  219.     
  220. : #Lines    (   -   #lines  )    ( looks in the textedit record to )
  221.     @TEHandle @ teNLines + W@  ;    ( see how many lines of text there
  222.                       are in this file )
  223. : adjustFontMenu
  224. \ adjust font menu and currentFont variable
  225.     myStyle w@ ( font ID ) fontName call getFname
  226.     #fonts @ 0 DO
  227.         fontMenu @ i itemName call GetItem
  228.         itemName fontName =string 
  229.         IF  FontMenu @ currentFont @ 0 check 
  230.             \ uncheck previous font selection 
  231.             FontMenu @ i -1 check
  232.              i currentFont !
  233.             leave
  234.         THEN
  235.     LOOP
  236. ;
  237.  
  238. : adjustStyleMenu { | face - }
  239.     myStyle tsFace + w@ -> face
  240.     8 0 DO 
  241.       1 i scale face and ( get style bit )
  242.       if -1 else 0 then
  243.       styleMenu @ i 2+ rot check 
  244.     LOOP    
  245. ;
  246.     
  247. : adjustSizeMenu
  248.     SizeMenu @ currentSize @ 0 check 
  249.     myStyle tsSize + w@ ( size )
  250.     SizeIDTable + c@ ( sizeID )
  251.     dup currentSize !
  252.     SizeMenu @ swap -1 check     
  253. ;
  254.  
  255. : getCurrentStyle { | LHite FAsc -- }
  256.     ( updates variable currentFont )
  257.     ( size and Face kept in myStyle )
  258.     ( LHite and FAsc are currently not used )
  259.  
  260.     @TEHandle @ teselStart + w@ \ get start of selection
  261.                   \ (or insertion point)
  262.     ( offset ) myStyle ^ LHite ^ FAsc @TEHandle
  263.         call TEGetStyle
  264.     
  265.     adjustFontMenu
  266.     adjustStyleMenu
  267.     adjustSizeMenu
  268. ;
  269.  
  270. : AdjustTERect                ( adjust terect size for the
  271.                       presence of scrollbars )
  272.     portRect Editor + 4 + W@    ( get bottom coord )
  273.     16 -                 ( subtract 16 for height of scrollbar )
  274.     teViewRect @TEHandle @ + 4 + W!    ( store new coord back in text edit
  275.                       record )
  276.                       
  277.     portRect Editor + 6 + W@    ( get right coord )
  278.     16 -                 ( subtract 16 for width of scrollbar )
  279.     teViewRect @TEHandle @ + 6 + W!    ( store new coord in textedit record )
  280. ;
  281.     
  282. : Visible?    (   -  f  )        ( checks visible flag in window )
  283.     Editor wVisible + C@  ;        ( record to see if window is 
  284.                       currently visible )
  285.  
  286. \ ***** event handlers *****
  287.  
  288. : ACTIVATE-HANDLER
  289.     RUN-ACTIVATE
  290.     EVENT-RECORD Modifiers + W@    ( get modifiers word )
  291.     1 AND IF     
  292.         @TEHandle CALL TEActivate
  293.         getCurrentStyle
  294.     ELSE     
  295.         @TEHandle CALL TEDeactivate
  296.     THEN    
  297. ;
  298.  
  299.     
  300. : UPDATE-HANDLER
  301.     Editor CALL SetPort
  302.     AdjustTERect
  303.     Editor CALL BeginUpdate
  304.        Editor CALL DrawControls
  305.        Editor CALL DrawGrowIcon
  306.        Editor portRect + @TEHandle CALL TEUpdate
  307.     Editor CALL EndUpdate
  308. ;
  309.  
  310. : CONTENT-HANDLER { | theMouse -- }
  311.     RUN-CONTENT
  312.     Editor CALL SetPort
  313.  
  314.     ^ theMouse CALL GetMouse
  315.     theMouse @TEHandle @ TEViewRect + call PtInRect
  316.     IF 
  317.         theMouse Shift? @TEHandle CALL TEClick
  318.         getCurrentStyle        
  319.     THEN
  320. ;
  321.  
  322. : CLOSEBOX-HANDLER
  323.     Editor                ( Editor windowpointer )
  324.     EVENT-RECORD Where + @        ( global mouse coordinates )
  325.     CALL TrackGoAway        ( follow the mouse to see if it
  326.                       is released in the closebox )
  327.     IF Editor CALL HideWindow THEN
  328. ;
  329.     
  330.     
  331. \ **** main editor example code *****
  332.  
  333. : POP-UP
  334.     Editor CALL ShowWindow
  335.     Editor CALL SelectWindow    ( selecting the Editor window )
  336.     EditBar @ CALL SetMenuBar    ( make EditBar the current menubar )
  337.     CALL DrawMenuBar ;        ( redraw the menubar )
  338.     
  339. : ShutDown
  340.     Editor CALL HideWindow        ( hide window when done editing )
  341.     PAUSE                ( PAUSE so that the i/o task can 
  342.                       have a turn and handle the
  343.                       deactivate event generated by
  344.                       the closing of the window )
  345.     MACH.MBAR            ( put the MACH menubar back on screen )
  346.     @TEHandle CALL TEDispose   
  347. ;
  348.  
  349. : SetScrollLimits
  350.     Scroll @ 0 CALL SetMinCtl
  351.     Scroll @ #Lines CALL SetMaxCtl   
  352.     Scroll @ 0 CALL SetCtlValue 
  353.     0 lastVs !  
  354.     hScroll @ 0 CALL SetMinCtl
  355.     hScroll @ 1000 CALL SetMaxCtl   
  356.     hScroll @ 0 CALL SetCtlValue 
  357.     0 lastHs !  
  358. ;
  359.  
  360.  
  361. : EditFile   {   | char exitflag --   }
  362.     BEGIN
  363.         Visible?
  364.         IF
  365.             ?TERMINAL IF
  366.             KEY -> char    ( get the character )
  367.                char 14 = IF
  368.                    0 -> exitflag        ( if cmd '.' exit )
  369.             ELSE
  370.                 char @TEHandle CALL TEKey    ( else insert )
  371.                 1 -> exitflag            ( char )
  372.             THEN
  373.         ELSE
  374.                 1 -> exitflag    ( if no key pressed, keep looping )
  375.             THEN
  376.         
  377.         ELSE
  378.             0 -> exitflag        ( if window's been closed, exit )
  379.         THEN
  380.     exitflag            ( check exit condition )
  381.     WHILE
  382.         @TEHandle CALL TEIdle
  383.     REPEAT
  384. ;
  385.     
  386.     
  387. : Open 
  388.     Pop-Up
  389.     Editor CALL SetPort
  390.        
  391.     TERect TERect CALL TEStyleNew TEHandle ! \ get new style TE record 
  392.     -1 teCROnly @TEHANDLE @ + W!        ( no word wrap )
  393.     -1 teCarAct @TEHandle @ + C!        ( activate caret )
  394.     -1 @TEHandle call TEAutoView
  395.  
  396.     ( get the first 1K of text )
  397.     0 VIRTUAL 1024 0 @TEHandle TEStylinsert
  398.     0 0 @TEHandle CALL TESetSelect
  399.     15 ( doAll ) myStyle -1 ( redraw) @TEHandle
  400.         call TESetStyle    
  401.     adjustFontMenu
  402.     adjustStyleMenu
  403.     adjustSizeMenu
  404.        
  405.     AdjustTERect                ( initialize the text )
  406.     PortRect Editor + @TEHandle CALL TEUpdate 
  407.     @TEHandle CALL TEDeactivate
  408.     @TEHandle CALL TEActivate
  409.  
  410.     SetScrollLimits                ( initialize the window's )
  411.     Editor CALL DrawControls        ( appearance )
  412.     Editor CALL DrawGrowIcon
  413.  
  414.     ['] UPDATE-HANDLER UpdateHook !        ( install custom event )
  415.     ['] CONTENT-HANDLER ContentHook !    ( handling routines )
  416.     ['] ACTIVATE-HANDLER ActivateHook !    
  417.     ['] CLOSEBOX-HANDLER CloseBoxHook !  ;
  418.        
  419.     
  420. \ ***** menu handlers *****
  421.  
  422. : HandleDeskAcc ( item# -  )
  423.     APPLEMENU @ SWAP DESKNAME CALL GETITEM    
  424.     DESKNAME CALL OPENDESKACC
  425.     DROP    
  426. ;
  427.  
  428. : DO-APPLE ( item# -  )        ( handles selections from the apple menu )
  429.     dup 1 =            ( check to see if it is the 'about' item )
  430.     IF
  431.         ( AboutEdit    )    ( About Editor ... )
  432.         drop
  433.     ELSE            ( otherwise, handle it as a desk accessory )
  434.         HandleDeskAcc
  435.     THEN 
  436. ;
  437.     
  438.  
  439. : NewFile ;            ( This is where the other menu items )
  440. : OpenFile ;            ( would be handled )
  441. : CloseFile ;
  442. : SaveFile ;
  443. : SaveAs ;
  444. : Revert ;
  445.  
  446. : DO-FILE ( item# -  )        ( handles selections from the file menu )
  447.     CASE
  448.     1 OF    NewFile        ENDOF
  449.     2 OF      OpenFile    ENDOF
  450.     3 OF     CloseFile    ENDOF
  451.     4 OF    SaveFile    ENDOF
  452.     5 OF    SaveAs        ENDOF
  453.     6 OF    Revert        ENDOF
  454.     ENDCASE  ;
  455.  
  456. : DO-EDIT ( item# - )        ( handles selections from the edit menu )
  457.     CASE
  458.     1 OF    ( TEUndo )        ENDOF
  459.     3 OF    @TEHandle CALL TECut    ENDOF
  460.     4 OF    @TEHandle CALL TECopy    ENDOF
  461.     5 OF    @TEHandle CALL TEStylPaste ENDOF
  462.     6 OF    @TEHandle CALL TEDelete    ENDOF
  463.     ENDCASE  ;
  464.  
  465. : DO-Font { item# | fontID - }    ( handles selections from the Font menu )
  466.     FontMenu @ item# Fontname call getitem
  467.     Fontname ^ fontID call getFNum
  468.     ^ fontID w@ myStyle w! 
  469.         \ put into tsFont field of style record
  470.     1 ( doFont) myStyle -1 ( redraw) @TEHandle
  471.         call TESetStyle
  472.     FontMenu @ currentFont @ 0 check 
  473.     FontMenu @ item# -1 check
  474.      item# currentFont !
  475. ;
  476.  
  477. : Do-Style { item# | facefield -- }
  478.     myStyle tsFace + -> facefield
  479.     item# CASE
  480.         1 OF ( plain text ) 
  481.           0 facefield w!
  482.         ENDOF     
  483.         
  484.         facefield w@ 
  485.         1 item# 2- scale xor 
  486.         facefield w! \ flip bit
  487.     ENDCASE
  488.  
  489.     2 ( doFace) myStyle -1 ( redraw) @TEHandle
  490.         call TESetStyle
  491.     adjustStyleMenu
  492. ;
  493.  
  494.     
  495. : Do-Size  ( item# - )     ( handles selections from the size menu )
  496.     SizeTable + c@
  497.     myStyle tsSize + w!
  498.     4 ( doSize) myStyle -1 ( redraw) @TEHandle
  499.         call TESetStyle
  500.     adjustSizeMenu
  501. ;
  502.             
  503. : MBAR-HANDLER  ( item# menuID -  )        ( this word handles )
  504.     CASE                    ( selections from the )
  505.     APPLEID OF DO-APPLE      ENDOF        ( whole edit menubar )
  506.     FILEID     OF DO-FILE      ENDOF
  507.      EDITID    OF DO-EDIT    ENDOF
  508.     FontID     OF DO-Font    ENDOF
  509.     SIZEID    OF DO-Size    ENDOF
  510.     STYLEID    OF DO-Style    ENDOF
  511.     ENDCASE  
  512.     0 CALL HILITEMENU  
  513. ;
  514.  
  515.  
  516. \ ***** control action routines *****
  517.  
  518. ( A control action routine specifies what action should take place
  519.   WHILE a control is being held down.)
  520.  
  521. : ScrollText  { dv  dh  --   }
  522.     dh dv @TEHandle CALL TEScroll   
  523. ;
  524.     
  525. : DO-Scroll { part-code  | ctlvalue  -  }
  526.    part-code
  527.    CASE
  528.       inuparrow OF  Scroll @ CALL GetCtlValue  -> ctlvalue
  529.               ctlvalue 0= NOT 
  530.             IF
  531.                   Scroll @ ctlvalue 1- CALL SetCtlValue
  532.             5 0  ScrollText        
  533.             THEN
  534.         ENDOF
  535.                 
  536.       indownarrow OF  Scroll @ CALL GetCtlValue  -> ctlvalue
  537.         ctlvalue #Lines = NOT
  538.             IF
  539.             Scroll @ ctlvalue 1+ CALL SetCtlValue
  540.             -5 0 ScrollText    
  541.             THEN
  542.         ENDOF
  543.                 
  544.       inpageup  OF  Scroll @ CALL GetCtlValue  -> ctlvalue
  545.         ctlvalue 0= NOT 
  546.             IF
  547.             Scroll @ ctlvalue 5 - CALL SetCtlValue
  548.             25 0  ScrollText    
  549.             THEN
  550.         ENDOF
  551.                 
  552.       inpagedown OF  Scroll @ CALL GetCtlValue   -> ctlvalue
  553.         ctlvalue #Lines = NOT
  554.              IF                
  555.                   Scroll @ ctlvalue 5 + CALL SetCtlValue
  556.             -25 0  ScrollText   
  557.              THEN
  558.         ENDOF
  559.    ENDCASE  
  560.    Scroll @ call GetCtlValue lastVs ! 
  561. ;
  562.  
  563. : DO-hScroll { part-code  | ctlvalue  -  }
  564.    part-code
  565.    CASE
  566.       inuparrow OF hScroll @ CALL GetCtlValue  -> ctlvalue
  567.               ctlvalue 0= NOT 
  568.             IF
  569.                   hScroll @ ctlvalue 1- CALL SetCtlValue
  570.             0 5 ScrollText        
  571.             THEN
  572.         ENDOF
  573.                 
  574.       indownarrow OF hScroll @ CALL GetCtlValue  -> ctlvalue
  575.         ctlvalue #Lines = NOT
  576.             IF
  577.             hScroll @ ctlvalue 1+ CALL SetCtlValue
  578.             0 -5 ScrollText    
  579.             THEN
  580.         ENDOF
  581.                 
  582.       inpageup  OF hScroll @ CALL GetCtlValue  -> ctlvalue
  583.         ctlvalue 0= NOT 
  584.             IF
  585.             hScroll @ ctlvalue 5 - CALL SetCtlValue
  586.             0 25 ScrollText    
  587.             THEN
  588.         ENDOF
  589.                 
  590.       inpagedown OF hScroll @ CALL GetCtlValue  -> ctlvalue
  591.         ctlvalue #Lines = NOT
  592.              IF                
  593.                   hScroll @ ctlvalue 5 + CALL SetCtlValue
  594.             0 -25 ScrollText   
  595.              THEN
  596.         ENDOF
  597.    ENDCASE    
  598.    hScroll @ call GetCtlValue lastHs ! 
  599. ;
  600.  
  601. : ControlAction  ( part-code  control-handle -  )
  602.     CASE
  603.          Scroll @ OF DO-Scroll     ENDOF
  604.         hScroll @ OF DO-hScroll ENDOF
  605.         swap drop
  606.     ENDCASE
  607. ;
  608.  
  609.  
  610. \ ***** scrollbar thumb control handler *****
  611.  
  612. : DO-vThumb { | ctlV }
  613.     inThumb = IF
  614.     scroll @ call getCtlValue -> ctlV
  615.     lastVs @ ctlV - 5 * 0 scrollText
  616.     ctlV lastVs !
  617.     THEN
  618. ;
  619.  
  620. : DO-hThumb { | ctlV }
  621.     inThumb = IF
  622.     hscroll @ call getCtlValue -> ctlV
  623.     0 lastHs @ ctlV - 5 * scrollText
  624.     ctlV lastHs !
  625.     THEN 
  626. ;
  627.   
  628. : ControlHandler  ( part-code  control-handle -  )
  629.     CASE
  630.          Scroll @ OF DO-vThumb     ENDOF
  631.         hScroll @ OF DO-hThumb  ENDOF
  632.         swap drop
  633.     ENDCASE
  634. ;
  635.  
  636.  
  637.  
  638. \ ***** initialization *****
  639.  
  640. : INIT-MBAR
  641.     EditBar ADD
  642.     EditBar APPLEMENU ADD        
  643.     APPLEMENU @ "drvr call addresmenu
  644.     EditBar FileMenu  ADD
  645.     EditBar EditMenu  ADD
  646.     EditBar FontMenu  ADD    
  647.     Fontmenu @ "font call addresmenu
  648.     Fontmenu @ call countMItems #fonts !
  649.     EditBar SizeMenu  ADD 
  650.     EditBar StyleMenu ADD
  651. ;
  652.     
  653. : INIT-TASK
  654.     Editor ADD        ( make the Editor window )
  655.     Editor Scroll ADD    ( add vertical scroll bar )
  656.     Editor hScroll ADD    ( add horizontal scroll bar )
  657.     Editor EditTask BUILD ;    ( link the window to the task )
  658.     
  659. : START-TASK
  660.     ACTIVATE        
  661.     ['] ControlAction CAction !    
  662.     ['] ControlHandler Control-Vector !
  663.     ['] MBAR-HANDLER MENU-VECTOR !    ( install menu handling routine )
  664.     BEGIN
  665.         STANDARD-GETFILE
  666.         IF
  667.         Open
  668.         EditFile
  669.         ShutDown
  670.         THEN
  671.         ['] RUN-UPDATE UpdateHook !        ( restore old vectors )
  672.         ['] RUN-CONTENT ContentHook !
  673.         ['] RUN-ACTIVATE ActivateHook !
  674.         ['] RUN-CLOSEBOX CloseBoxHook !
  675.         SLEEP STATUS W!    ( put Editor task to sleep )
  676.         PAUSE        ( exit this task )
  677.     AGAIN 
  678. ;
  679.  
  680. : INIT-EDIT                ( initializes and starts Editor )
  681.     INIT-TASK            ( make the task and window )
  682.     INIT-MBAR            ( make the menubar and the menus )
  683.     EditBar EditTask MBAR>TASK    ( link the menubar to the task )
  684.     4 myStyle w!    \ default font, Monaco
  685.     0 myStyle 2+ w!    \ default face, plain text
  686.     9 myStyle 4 + w! \ default size, 9 point
  687.     0 myStyle 6 + !    \ RGBcolor = ...
  688.     0 myStyle 10 + w! \ ...black    
  689.     4   TERect     W!        ( define the text edit rectangle )
  690.     4   TERect 2+  W!
  691.     288 TERect 4 + W!
  692.     503 TERect 6 + W!
  693.     EditTask START-TASK  
  694. ;
  695.  
  696.  
  697. : EDIT        ( wakes up Editor task )
  698.     EDITTASK @ 
  699.     IF
  700.            WAKE STATUS TASK-> EditTask W!
  701.     ELSE
  702.           INIT-EDIT
  703.     THEN
  704. ;
  705.